home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / mac / Mac.prim.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-09  |  8.9 KB  |  541 lines

  1. /* Mac.prim.c  */
  2. /* created 4Dec92  e  from the file M68.prim.s of 17Nov92 */
  3.  
  4. /* how to make this file:
  5.   0) run M68.prim.s through ThinkC preprocessor
  6.   1) grep: sp@(\([0-9]*\)) => \1(sp)
  7.   2) grep: sp@(\([+0-9]*\)) => (\1)(sp)
  8.   3) grep: sp@(\(-[0-9]*\)) => \1(sp)
  9.   4) frep: sp@- => -(sp)
  10.   5) frep: sp@ => (sp)
  11.   6) grep: a\([0-9]*\)@(\([0-9]*\)) => \2(a\1)
  12.   7) grep: a\([0-9]*\)@(\([+0-9]*\)) => (\2)(a\1)
  13.   8) grep: a\([0-9]*\)@(\(-[0-9]*\)) => \2(a\1)
  14.   9) grep: a\([0-9]*\)@- => -(a\1)
  15.  10) grep: a\([0-9]*\)@ => (a\1)
  16.  11) frep: " 0(a" => " (a" [ note the leading space!]
  17.  12) frep: .word => dc.w
  18.  13) frep: jra => bra
  19.  14) frep: jgt => bgt
  20.  15) frep: jne => bne
  21.  16) frep: jpl => bpl
  22.  17) frep: jge => bge
  23.  18) frep: jeq => beq
  24.  19) frep: movl => move.l
  25.  1a) frep: cmpl => cmp.l
  26.  1b) frep: addl => add.l
  27.  1c) frep: andl => and.l [whole tokens only!]
  28.  1d) frep: orl => or.l
  29.  1e) frep: asll => asl.l
  30.  1f) frep: asrl => asr.l
  31.  1g) frep: fmovel => fmove.l
  32.  1h) frep: addql => addq.l
  33.  1i) frep: subql => subq.l
  34.  1j) frep: tstl => tst.l
  35.  1k) frep: clrl => clr.l
  36.  1l) frep: moveml => movem.l
  37.  1m) frep: fmoved => fmove.d
  38.  1n) frep: movw => move.w
  39.  1o) frep: ftstx => ftst.x
  40.  1p) frep: fgetexpd => fgetexp.d
  41.  1q) frep: fatand => fatan.d
  42.  1r) frep: fcosd => fcos.d
  43.  1s) frep: fetoxd => fetox.d
  44.  1t) frep: flognx => flogn.x
  45.  1u) frep: fsind => fsin.d
  46.  1v) frep: fsqrtx => fsqrt.x
  47.  1w) frep: fintrzx => fintrz.x
  48.  1x) frep: fcmpx => fcmp.x
  49.  
  50.  20) replace "; " with \n
  51.  21) remove .align 2 delarations
  52.  22) replace .globl declarations with C declarations
  53.  23) remove leading underscores on labels
  54.  
  55.  2a) grep: \([0-9]\): => @\1:
  56.  2b) manually patch branch labels
  57.      - remove extraneous labels
  58.      - change 1f & 1b to @1 as appropriate
  59.      - change 1f & 1b to @9 as appropriate
  60.      - change 2f & 2b to @2
  61.      - change 3f & 3b to @3
  62.      - change 4f & 4b to @4
  63.  2c) manually replace @<digit> by <function-name>_<digit>
  64.        merging multiple labeles to the same address
  65.  2d) change quicksave => @quicksave
  66.  2e) change finishfloat => @finishfloat
  67.  2f) prefix appropriate labels with extern
  68.  
  69.  3a) manually format
  70.  3b) wrap the code with a dummy c function
  71.  3c) add the next few lines...
  72. */
  73.  
  74. #include "ml_state.h"
  75. extern MLState_t *MLproc;
  76. extern int overflow_e0[];
  77. extern int ln_e0[];
  78. extern int sqrt_e0[];
  79.  
  80. int sigh_resume();
  81. int saveregs();
  82. int restoreregs();
  83. int sigh_return_a();
  84. int handle_a();
  85. int return_a();
  86. int request_fault();
  87. int callc_a();
  88. int savefpregs();
  89. int restorefpregs();
  90. int adjust_limit();
  91. int saved_pc();
  92. int array_a();
  93. int create_r_a();
  94. int create_b_a();
  95. int create_s_a();
  96. int create_v_a();
  97. int try_lock_a();
  98. int unlock_a();
  99. int floor_a();
  100. int logb_a();
  101. int scalb_a();
  102. int fpenable();
  103. int fpdisable();
  104. int arctan_a();
  105. int cos_a();
  106. int exp_a();
  107. int ln_a();
  108. int sin_a();
  109. int sqrt_a();
  110.  
  111. void dummy_c_fun()
  112. {
  113. asm    {
  114.  
  115.     dc.w ((4*(5))+2)
  116. extern sigh_return_a:
  117.     move.l (sp)+,a5
  118.     move.l 48(sp),a5
  119.     move.l #6,48(a5)
  120.     bra @quicksave
  121.  
  122. extern sigh_resume:
  123.     move.l (sp)+,a5
  124.     move.l 48(sp),a5
  125.     move.l #7,48(a5)
  126.     bra @quicksave
  127.     
  128.     dc.w ((4*(5))+2)
  129. extern handle_a:
  130.     move.l (sp)+,a5
  131.     move.l 48(sp),a5
  132.     move.l #1,48(a5)
  133.     bra @quicksave
  134.     
  135.     dc.w ((4*(5))+2)
  136. extern return_a:
  137.     move.l (sp)+,a5
  138.     move.l 48(sp),a5
  139.     move.l #0,48(a5)
  140.     bra @quicksave
  141.     
  142. extern request_fault:
  143.     move.l (sp)+,a5
  144.     move.l 48(sp),a5
  145.     move.l #2,48(a5)
  146.     bra @quicksave
  147.     
  148.     dc.w ((4*(5))+2)
  149. extern callc_a:
  150.     bgt @callc_a_2
  151.     lea @callc_a,a5
  152.     move.l #((1 * 16) - 1),d4
  153.     rts
  154. @callc_a_2:
  155.     move.l (sp)+,a5
  156.     move.l 48(sp),a5
  157.     move.l #4,48(a5)
  158.  
  159. @quicksave:
  160.     clr.l 44(a5)
  161.     move.l a6,(a5)
  162.     movem.l d6-d7/a0-a2,8(a5)
  163.     move.l d3,36(a5)
  164.     movem.l (sp)+,d2-d7/a2-a6
  165.     rts
  166.  
  167. extern saveregs:
  168.     pea (a5)
  169.     move.l (48+4)(sp),a5
  170.     move.l (sp)+,40(a5)
  171.     clr.l 44(a5)
  172.     tst.l d5
  173.     bne @saveregs_1
  174.     move.l #5,48(a5)
  175. @saveregs_1:
  176.     move.l d4,96(a5)
  177.     move.l a6,(a5)
  178.     movem.l d6-d7/a0-a4,8(a5)
  179.     move.l d3,36(a5)
  180.     movem.l (sp)+,d2-d7/a2-a6
  181.     rts
  182.  
  183. extern restoreregs:
  184.     movem.l d2-d7/a2-a6,-(sp)
  185.     move.l 48(sp),a5
  186.     move.l (a5),a6
  187.     movem.l 4(a5),d5-d7/a0-a4
  188.     move.l 36(a5),d3
  189.     addq.l #1,44(a5)
  190.     tst.l 72(a5)
  191.     bne @restoreregs_3
  192.     tst.l 64(a5)
  193.     bne @restoreregs_2
  194. @restoreregs_1:
  195.     pea @saveregs
  196.     move.l 40(a5),a5
  197.     cmp.l a6,d5
  198.     jmp (a5)
  199. @restoreregs_2:
  200.     tst.l 60(a5)
  201.     bne @restoreregs_1
  202.     tst.l 56(a5)
  203.     bne @restoreregs_1
  204.     addq.l #1,52(a5)
  205. @restoreregs_3:
  206.     clr.l d5
  207.     bra @restoreregs_1
  208.     
  209. extern savefpregs:
  210.     link a6, #-4
  211.     move.l a0, -4(a6)
  212.     move.l MLproc, a0
  213.     move.l (a0), a0
  214.     move.l #((6*8)*64+(((4*(0x8+2))+2))), (a0)+
  215.     fmove.d fp2, (a0)+
  216.     fmove.d fp3, (a0)+
  217.     fmove.d fp4, (a0)+
  218.     fmove.d fp5, (a0)+
  219.     fmove.d fp6, (a0)+
  220.     fmove.d fp7, (a0)+
  221.     move.l -4(a6), a0
  222.     unlk a6
  223.     rts
  224.     
  225. extern restorefpregs:
  226.     link a6, #-4
  227.     move.l a0, -4(a6)
  228.     move.l 8(a6), a0
  229.     fmove.d (a0)+, fp2
  230.     fmove.d (a0)+, fp3
  231.     fmove.d (a0)+, fp4
  232.     fmove.d (a0)+, fp5
  233.     fmove.d (a0)+, fp6
  234.     fmove.d (a0)+, fp7
  235.     move.l -4(a6), a0
  236.     unlk a6
  237.     rts
  238. /*
  239. extern adjust_limit:
  240.     move.w cc,d5
  241.     move.l saved_pc,-(sp)
  242.     move.w d5,-(sp)
  243.     clr.l d5
  244.     rtr
  245. */
  246.     dc.w ((4*(5))+2)
  247. extern array_a:
  248.     move.l (a0),d1
  249.     asr.l #1,d1
  250.     move.l d1,d2
  251.     asl.l #6,d2
  252.     or.l #((4*(0x8+1))+2),d2
  253.     asl.l #2,d1
  254.     move.l a6,d4
  255.     add.l d1,d4
  256.     cmp.l d4,d5
  257.     bpl @array_a_4
  258.     lea @array_a,a5
  259.     move.l #((1 * 16) - 1),d4
  260.     rts
  261. @array_a_4:
  262.     move.l 4(a0),d0
  263.     move.l d2,(a6)+
  264.     move.l a6,a0
  265.     bra @array_a_3
  266. @array_a_2:
  267.     move.l d0,(a6)+
  268. @array_a_3:
  269.     subq.l #4,d1
  270.     bge @array_a_2
  271.     move.l (a1),a3
  272.     cmp.l a6,d5
  273.     jmp (a3)
  274.     
  275.     dc.w ((4*(5))+2)
  276. extern create_r_a:
  277.     move.l a0,d1
  278.     asr.l #1,d1
  279.     move.l d1,d2
  280.     asl.l #6,d2
  281.     asl.l #3,d1
  282.     add.l #((4*(0x8+5))+2),d2
  283.     move.l a6,d4
  284.     add.l d1,d4
  285.     cmp.l d4,d5
  286.     bpl @create_r_a_4
  287.     lea @create_r_a,a5
  288.     move.l #((1 * 16) - 1),d4
  289.     rts
  290. @create_r_a_4:
  291.     move.l d2,(a6)+
  292.     move.l a6,a0
  293.     add.l d1,a6
  294.     move.l (a1),a3
  295.     cmp.l a6,d5
  296.     jmp (a3)
  297.     
  298.     dc.w ((4*(5))+2)
  299. extern create_b_a:
  300.     move.l a0,d1
  301.     asr.l #1,d1
  302.     move.l d1,d2
  303.     asl.l #6,d2
  304.     add.l #3,d1
  305.     add.l #((4*(0x8+4))+2),d2
  306.     and.l #~3,d1
  307.     move.l a6,d4
  308.     add.l d1,d4
  309.     cmp.l d4,d5
  310.     bpl @create_b_a_4
  311.     lea @create_b_a,a5
  312.     move.l #((1 * 16) - 1),d4
  313.     rts
  314. @create_b_a_4:
  315.     move.l d2,(a6)+
  316.     move.l a6,a0
  317.     add.l d1,a6
  318.     move.l (a1),a3
  319.     cmp.l a6,d5
  320.     jmp (a3)
  321.     
  322.     dc.w ((4*(5))+2)
  323. extern create_s_a:
  324.     move.l a0,d1
  325.     asr.l #1,d1
  326.     move.l d1,d2
  327.     asl.l #6,d2
  328.     add.l #3,d1
  329.     add.l #((4*(0x8+2))+2),d2
  330.     and.l #~3,d1
  331.     move.l a6,d4
  332.     add.l d1,d4
  333.     cmp.l d4,d5
  334.     bpl @create_s_a_4
  335.     lea @create_s_a,a5
  336.     move.l #((1 * 16) - 1),d4
  337.     rts
  338. @create_s_a_4:
  339.     move.l d2,(a6)+
  340.     move.l a6,a0
  341.     add.l d1,a6
  342.     move.l (a1),a3
  343.     cmp.l a6,d5
  344.     jmp (a3)
  345.     
  346.     dc.w ((4*(5))+2)
  347. extern create_v_a:
  348.     move.l (a0),d1
  349.     asr.l #1,d1
  350.     move.l d1,d2
  351.     asl.l #6,d2
  352.     or.l #((4*(0x8+0))+2),d2
  353.     asl.l #2,d1
  354.     move.l a6,d4
  355.     add.l d1,d4
  356.     cmp.l d4,d5
  357.     bpl @create_v_a_4
  358.     lea @create_v_a,a5
  359.     move.l #((1 * 16) - 1),d4
  360.     rts
  361. @create_v_a_4:
  362.     move.l d2,(a6)+
  363.     move.l 4(a0),a5
  364.     move.l a6,a0
  365.     move.l #1,d1
  366. @create_v_a_3:
  367.     move.l (a5),(a6)+
  368.     move.l 4(a5),a5
  369.     cmp.l a5,d1
  370.     bne @create_v_a_3
  371.     move.l (a1),a3
  372.     cmp.l a6,d5
  373.     jmp (a3)
  374.     
  375.     dc.w ((4*(5))+2)
  376. extern try_lock_a:
  377.     move.l (a0),d0
  378.     move.l #1,(a0)
  379.     move.l d0,a0
  380.     move.l (a1),a3
  381.     cmp.l a6,d5
  382.     jmp (a3)
  383.     
  384.     dc.w ((4*(5))+2)
  385. extern unlock_a:
  386.     move.l #3,(a0)
  387.     move.l #1,a0
  388.     move.l (a1),a3
  389.     cmp.l a6,d5
  390.     jmp (a3)
  391.     
  392.     dc.w ((4*(5))+2)
  393. extern floor_a:
  394.     fmove.d (a0),fp0
  395.     ftst.x fp0
  396.     fblt @floor_a_1
  397.     fintrz.x fp0,fp0
  398.     fmove.l fp0,d0
  399.     asl.l #1,d0
  400.     trapv
  401.     addq.l #1,d0
  402.     move.l d0,a0
  403.     move.l (a1),a3
  404.     cmp.l a6,d5
  405.     jmp (a3)
  406. @floor_a_1:
  407.     fintrz.x fp0,fp1
  408.     fmove.l fp1,d0
  409.     asl.l #1,d0
  410.     trapv
  411.     fcmp.x fp0,fp1
  412.     fbeq @floor_a_9
  413.     subq.l #1,d0
  414.     trapv
  415.     move.l d0,a0
  416.     move.l (a1),a3
  417.     cmp.l a6,d5
  418.     jmp (a3)
  419. @floor_a_9:
  420.     addq.l #1,d0
  421.     move.l d0,a0
  422.     move.l (a1),a3
  423.     cmp.l a6,d5
  424.     jmp (a3)
  425.     
  426.     dc.w ((4*(5))+2)
  427. extern logb_a:
  428.     fgetexp.d (a0),fp0
  429.     fmove.l fp0,d0
  430.     asl.l #1,d0
  431.     addq.l #1,d0
  432.     move.l d0,a0
  433.     move.l (a1),a3
  434.     cmp.l a6,d5
  435.     jmp (a3)
  436.     
  437.     dc.w ((4*(5))+2)
  438. extern scalb_a:
  439.     lea overflow_e0+4,a0
  440.     move.l d7,a1
  441.     move.l (a1),a3
  442.     cmp.l a6,d5
  443.     jmp (a3)
  444.     
  445. extern fpenable:
  446.     fmove.l #0x3400,fpcr
  447.     rts
  448.  
  449. extern fpdisable:
  450.     fmove.l #0,fpcr
  451.     rts
  452.     
  453.     dc.w ((4*(5))+2)
  454. extern arctan_a:
  455.     bgt @arctan_a_2
  456.     lea @arctan_a,a5
  457.     move.l #((1 * 16) - 1),d4
  458.     rts
  459. @arctan_a_2:
  460.     fatan.d (a0),fp0
  461.     bra @finishfloat
  462.     
  463.     dc.w ((4*(5))+2)
  464. extern cos_a:
  465.     bgt @cos_a_2
  466.     lea @cos_a,a5
  467.     move.l #((1 * 16) - 1),d4
  468.     rts
  469. @cos_a_2:
  470.     fcos.d (a0),fp0
  471.     bra @finishfloat
  472.     
  473.     dc.w ((4*(5))+2)
  474. extern exp_a:
  475.     bgt @exp_a_2
  476.     lea @exp_a,a5
  477.     move.l #((1 * 16) - 1),d4
  478.     rts
  479. @exp_a_2:
  480.     fetox.d (a0),fp0
  481.     bra @finishfloat
  482.     
  483.     dc.w ((4*(5))+2)
  484. extern ln_a:
  485.     bgt @ln_a_2
  486.     lea @ln_a,a5
  487.     move.l #((1 * 16) - 1),d4
  488.     rts
  489. @ln_a_2:
  490.     fmove.d (a0),fp0
  491.     ftst.x fp0
  492.     fble @ln_a_9
  493.     flogn.x fp0,fp0
  494.     bra @finishfloat
  495. @ln_a_9:
  496.     lea ln_e0+4,a0
  497.     move.l d7,a1
  498.     move.l (a1),a3
  499.     cmp.l a6,d5
  500.     jmp (a3)
  501.     
  502.     dc.w ((4*(5))+2)
  503. extern sin_a:
  504.     bgt @sin_a_2
  505.     lea @sin_a,a5
  506.     move.l #((1 * 16) - 1),d4
  507.     rts
  508. @sin_a_2:
  509.     fsin.d (a0),fp0
  510.     bra @finishfloat
  511.     
  512.     dc.w ((4*(5))+2)
  513. extern sqrt_a:
  514.     bgt @sqrt_a_2
  515.     lea @sqrt_a,a5
  516.     move.l #((1 * 16) - 1),d4
  517.     rts
  518. @sqrt_a_2:
  519.     fmove.d (a0),fp0
  520.     ftst.x fp0
  521.     fblt @sqrt_a_9
  522.     fsqrt.x fp0,fp0
  523.     bra @finishfloat
  524. @sqrt_a_9:
  525.     lea sqrt_e0+4,a0
  526.     move.l d7,a1
  527.     move.l (a1),a3
  528.     cmp.l a6,d5
  529.     jmp (a3)
  530.  
  531. @finishfloat:
  532.     move.l #((2)*64+(((4*(1))+2))),(a6)+
  533.     move.l a6,a0
  534.     fmove.d fp0,(a6)+
  535.     move.l (a1),a3
  536.     cmp.l a6,d5
  537.     jmp (a3)
  538.     
  539.     }
  540. }
  541.